home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
buffr2.zip
/
BUFFARAY.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-01-04
|
14KB
|
466 lines
Unit BuffAray;
{$R-,S-,O+}
{ Defines a Buffered Generic VirtualArray. MaxSize = 32 MegaBytes. }
{ The BufferedArray Object is a very high performance virtual array using }
{ multiple (8) buffers to manage array accesses through RAM. }
{ Each BufferedArray is internally divided into 8 sectors, each sector }
{ having 1 buffer assigned to it. Buffers are constrained such that they }
{ can never read from or write to adjacent sectors, but freely "patrol" }
{ within their own sector. To save some access time, buffers do not ever }
{ flush to disk unless the particular buffer has been written to, with }
{ the exceptions of the Copy and Store operations, which both Flush all }
{ buffers of the target BufferedArray. }
{ The Maximum possible (total) buffer size is 524,168 bytes, and is }
{ determined by GetMem's limit of 65521 bytes for a single structure. }
{ The User may select the (total) Buffer space to be used during the INIT }
{ operation by the MaxBuffsize variable, or allow the method to utilize }
{ (up to) all available RAM by selecting 0 for MaxBuffSize. }
{ Other than the differences in Load, Store, and Init, BufferedArrays }
{ are functionally identical with the VirtualArray Object, although the }
{ performance of the BufferedArray is a tremendous improvement. }
{ Remarks on Performance: There are 3 major influences on the performance }
{ characteristics of the BufferedArray. The first is "load factor" or the }
{ actual percentage of the disk file which resides in RAM. The second is }
{ the size of the individual buffers themselves. As the size of the }
{ buffers increases, the time required to Flush or Load each buffer also }
{ increases. Obviously, with a high load factor this is not much of a }
{ problem, but with a low load factor and a lot of random accesses, much }
{ time will be spent simply Loading or Flushing buffers. The third is }
{ proportional to the file size, and is simply the time required to SEEK }
{ a random address within the file (before Flushing or Loading). }
{ Of course, as with the much-maligned (by me) ExtendedArray, serial and }
{ closely-spaced accessing is always quite good (unless for some reason }
{ you force the buffers to be very small!). }
INTERFACE
Uses Dos,Crt;
Const
MaximumSize = 33554432; {32 MegaBytes}
Type
Flex = Array[0..0] of Byte;
Ptr = ^Flex;
BufferedArray = Object
ElSize : Word;
NumElems : LongInt;
Name : String[65];
F : File;
BSize : Word;
SSize : LongInt;
Buffer : Array[0..7] of Ptr;
UpDate : Array[0..7] of Boolean;
BuffLeft : Array[0..8] of LongInt;
Procedure Create;
Procedure Destroy;
Procedure Init (NumElements : LongInt; ElementSize : Word;
MaxBuffSize : LongInt; FileName : String);
Procedure Load (FileName : String; ElementSize : Word;
MaxBuffSize : LongInt);
{NOTE: Performing a LOAD should ONLY be done as a DIRECT}
{ substitution for performing an INIT operation}
{ Of course, CREATE should be used first.}
Procedure Store;
{NOTE: Performing a STORE has the same effect as}
{ performing a DESTROY, accept the data is}
{ saved in the filename given when performing INIT}
{FileNames May be up to 65 characters long, and may conist
of Directory and Path information as well as name and extension.
To Load, BufferedAray MUST be ONLY CREATEd (or DESTROYed)}
Procedure Accept (Var El; Index : LongInt; Size : Word);
Procedure Retrieve (Var El; Index : LongInt; Size : Word);
Procedure Copy (Var From : BufferedArray);
Procedure Swap (I,J : LongInt);
Function MaxSize : LongInt;
Function ElemSize : Word;
End;
IMPLEMENTATION
Const
AbsoluteMaxBuffer = 524168; {8 * 65521}
Procedure Error (Num : Byte; Name : String);
Begin
WriteLn;
Write ('BufferedArray ERROR[',Num:1,']: ');
Case Num of
0 : WriteLn ('Insufficient Free Disk Space for Requested BufferedArray.');
1 : WriteLn ('Unable to Open File ',Name);
2 : WriteLn ('Attempted to Access with wrong size Element.');
3 : WriteLn ('***** INDEX OUT OF BOUNDS *****');
4 : WriteLn ('Attempted to Copy from Un-Initialized BufferedArray.');
5 : WriteLn ('Attempted to Copy to Un-Initialized BufferedArray: ',Name);
6 : WriteLn ('Insufficient Free Disk Space for Requested Copy Operation.');
7 : WriteLn ('Insufficient Memory for Requested Operation.');
8 : WriteLn ('Attempted to Open File beyond DOS Size Limit of ',MaximumSize,' Bytes');
9 : WriteLn ('**** Unable to Allocate Buffer for ',Name,' ****');
10 : WriteLn ('**** BufferSize Too Small or Insufficient Memory ****');
11 : WriteLn ('**** Attempted to Load file using wrong ElementSize ****');
12 : WriteLn ('**** Attempted to Load into Initialized (or Loaded) BufferedArray ****');
End;
WriteLn ('**** PROGRAM TERMINATED ****');
WriteLn;
Write ('Press <Return> to Continue.... ');
ReadLn;
HALT (0)
End;
Function InBuff (V : BufferedArray; Index : LongInt; Buff : Byte) : Boolean;
Begin
If (Index*V.ElemSize >= V.BuffLeft[Buff]) and
(Index*V.ElemSize < (V.BuffLeft[Buff] + V.BSize))
Then InBuff := True
Else InBuff := False
End;
Procedure FlushBuff (Var V : BufferedArray; Buff : Byte);
Begin
Seek (V.F,V.BuffLeft[Buff]);
BlockWrite (V.F,V.Buffer[Buff]^,V.BSize)
End;
Procedure LoadBuff (Var V : BufferedArray; Buff : Byte);
Begin
Seek (V.F,V.BuffLeft[Buff]);
BlockRead (V.F,V.Buffer[Buff]^,V.BSize)
End;
Procedure MoveBuff (Var V : BufferedArray; Index : LongInt; Buff : Byte);
Var
Base : LongInt;
Begin
If V.UpDate[Buff] Then
Begin
FlushBuff (V,Buff);
V.UpDate[Buff] := False
End;
Base := ((Index*V.ElemSize) - (V.BSize Div 2));
Base := Base - (Base Mod V.ElemSize);
If Buff = 7
Then
If (Base+V.BSize) >= V.NumElems * V.ElemSize
Then
Base := (V.NumElems * V.ElemSize) - V.BSize;
If Buff < 7
Then
If (Base+V.BSize) >= V.SSize*(Buff+1)
Then
Base := (LongInt(Buff+1)*V.SSize) - V.BSize;
If Base < V.SSize*Buff
Then
Base := V.SSize*Buff;
V.BuffLeft[Buff] := Base;
LoadBuff (V,Buff)
End;
Function Sector (V : BufferedArray; Index : LongInt) : Byte;
Var
I : Integer;
Test : LongInt;
Temp : LongInt;
Begin
I := -1;
Test := 0;
Temp := (LongInt(V.ElemSize))*Index;
While Test <= Temp do
Begin
I := I + 1;
Test := Test+V.SSize
End;
If I > 7 Then I := 7;
Sector := Byte (I)
End;
Procedure BufferedArray.Create;
Var
I : Byte;
Begin
ElSize := 0;
NumElems := 0;
For I := 0 to 7 do BuffLeft[I] := 0;
BSize := 0;
For I := 0 to 7 do UpDate[I] := False;
Name := '';
End;
Procedure BufferedArray.Init (NumElements : LongInt; ElementSize : Word;
MaxBuffSize : LongInt; FileName : String);
Var
I,J : LongInt;
Buff : Ptr;
K,L : Word;
BuffSize : Word;
Buffers : Byte;
Begin
Name := FileName;
I := NumElements * LongInt (ElementSize);
If I > MaximumSize Then Error (8,'');
If I > DiskFree(0) Then Error (0,'');
If MaxBuffSize = 0 Then MaxBuffSize := MemAvail-1000;
If MaxBuffSize > AbsoluteMaxBuffer Then MaxBuffSize := AbsoluteMaxBuffer;
{***Set up File***}
Assign (F,Name);
{$I-} Rewrite (F,1); {$I+}
If IOResult <> 0 Then
Error (1,Name);
If I < 65521 Then BuffSize := Word (I) Else BuffSize := 65521;
If BuffSize > MemAvail Then BuffSize := MemAvail;
If BuffSize = 0 Then Error (7,'');
K := I Div BuffSize;
GetMem (Buff,BuffSize);
For L := 0 to BuffSize-1 do Buff^[L] := 0;
L := I-(LongInt(K) * BuffSize);
If I >= BuffSize
Then
For J := 0 to K-1 do BlockWrite (F,Buff^,BuffSize);
If L > 0 Then BlockWrite (F,Buff^,L);
Reset (F,1);
FreeMem (Buff,BuffSize);
If Buff = Nil Then Error (9,Name);
{***Set up Buffers***}
BSize := MaxBuffSize Div 8;
If (LongInt(BSize) * 8) > (NumElements*LongInt(ElementSize))
Then BSize := (NumElements*LongInt(ElementSize)) Div 8;
If BSize = 0 Then Error(10,'');
SSize := (NumElements*LongInt(ElementSize)) Div 8;
SSize := SSize - (SSize Mod ElementSize);
If BSize > SSize Then BSize := SSize;
BSize := BSize - (BSize Mod ElementSize);
For Buffers := 0 to 7 do
Begin
BuffLeft[Buffers] := Buffers*SSize;
GetMem (Buffer[Buffers],BSize)
End;
BuffLeft[8] := (NumElements*LongInt(ElementSize))-1;
NumElems := NumElements;
ElSize := ElementSize;
For Buffers := 0 to 7 do LoadBuff (Self,Buffers)
End;
Procedure BufferedArray.Destroy;
Var
I : Byte;
Begin
Close (F);
Erase (F);
For I := 0 to 7 do
FreeMem (Buffer[I],BSize);
Create
End;
Procedure BufferedArray.Store;
Var
I : Byte;
Begin
For I := 0 to 7 do FlushBuff (Self,I);
Close (F);
For I := 0 to 7 do
FreeMem (Buffer[I],BSize);
Create
End;
Procedure BufferedArray.Load (FileName : String; ElementSize : Word;
MaxBuffSize : LongInt);
Var
I : LongInt;
Buffers : Byte;
Begin
If Name <> '' Then Error (12,'');
Name := FileName;
Assign (F,Name);
{$I-} ReSet (F,1); {$I+}
If IOResult <> 0 Then
Error (1,Name);
I := FileSize (F);
NumElems := I Div ElementSize;
If NumElems*ElementSize <> I Then Error (11,Name);
If MaxBuffsize = 0 Then MaxBuffSize := MemAvail - 1000;
If MaxBuffSize > AbsoluteMaxBuffer Then MaxBuffSize := AbsoluteMaxBuffer;
BSize := MaxBuffSize Div 8;
If (LongInt(BSize) * 8) > (NumElems*LongInt(ElementSize))
Then BSize := (NumElems*LongInt(ElementSize)) Div 8;
If BSize = 0 Then Error(10,'');
SSize := (NumElems*LongInt(ElementSize)) Div 8;
SSize := SSize - (SSize Mod ElementSize);
If BSize > SSize Then BSize := SSize;
BSize := BSize - (BSize Mod ElementSize);
For Buffers := 0 to 7 do
Begin
BuffLeft[Buffers] := Buffers*SSize;
GetMem (Buffer[Buffers],BSize)
End;
BuffLeft[8] := (NumElems*LongInt(ElementSize))-1;
ElSize := ElementSize;
For Buffers := 0 to 7 do LoadBuff (Self,Buffers)
End;
Function BufferedArray.MaxSize : LongInt;
Begin
MaxSize := NumElems
End;
Function BufferedArray.ElemSize : Word;
Begin
ElemSize := ElSize
End;
Procedure BufferedArray.Accept (Var El; Index : LongInt; Size : Word);
Var
Buff : Flex Absolute El;
Sect : Byte;
Begin
Sect := Sector (Self,Index);
If Size <> ElSize Then Error (2,'');
If (Index >= NumElems) or (Index < 0) Then Error (3,'');
If Not InBuff (Self,Index,Sect)
Then
MoveBuff (Self,Index,Sect);
Move (Buff,Buffer[Sect]^[(Index*ElemSize)-BuffLeft[Sect]],Size);
UpDate[Sect] := True
End;
Procedure BufferedArray.Retrieve (Var El; Index : LongInt; Size : Word);
Var
Buff : Flex Absolute El;
Sect : Byte;
Begin
Sect := Sector (Self,Index);
If Size <> ElSize Then Error (2,'');
If (Index >= NumElems) or (Index < 0) Then Error (3,'');
If Not InBuff (Self,Index,Sect)
Then
MoveBuff (Self,Index,Sect);
Move (Buffer[Sect]^[(Index*ElemSize)-BuffLeft[Sect]],Buff,Size)
End;
Procedure BufferedArray.Copy (Var From : BufferedArray);
Var
Buff : Ptr;
NumRead : Word;
NumWritten : Word;
BuffSize : Word;
I : LongInt;
Sect : Byte;
Begin
For Sect := 0 to 7 do
Begin
FlushBuff (From,Sect);
FreeMem (Buffer[Sect],BSize)
End;
{$I-}
If (DiskFree(0)+FileSize(F)) <= FileSize(From.F) Then Error (6,Name);
Reset (From.F,1);
If IOResult <> 0 Then Error (4,'');
Rewrite (F,1);
If IOResult <> 0 Then Error (5,Name);
{$I+}
I := From.NumElems * LongInt (From.ElSize);
If I < 65521 Then BuffSize := Word (I) Else BuffSize := 65521;
If BuffSize > MemAvail Then BuffSize := MemAvail;
If BuffSize = 0 Then Error (7,'');
GetMem (Buff,BuffSize);
Repeat
BlockRead (From.F,Buff^,BuffSize,NumRead);
BlockWrite (F,Buff^,NumRead,NumWritten);
Until (NumRead = 0) or (NumWritten <> NumRead);
FreeMem (Buff,BuffSize);
Reset (From.F,1);
Reset (F,1);
ElSize := From.ElSize;
SSize := From.SSize;
NumElems := From.NumElems;
BSize := From.BSize;
BuffLeft := From.BuffLeft;
For Sect := 0 to 7 do
Begin
GetMem (Buffer[Sect],BSize);
LoadBuff (Self,Sect);
End
End;
Procedure BufferedArray.Swap (I,J : LongInt);
Var
T1,T2 : Ptr;
Begin
GetMem (T1,ElSize);
GetMem (T2,ElSize);
If (T1=Nil) or (T2=Nil) Then Error (7,'');
Retrieve (T1^,I,ElSize);
Retrieve (T2^,J,ElSize);
Accept (T1^,J,ElSize);
Accept (T2^,I,ElSize);
FreeMem (T1,ElSize);
FreeMem (T2,ElSize)
End;
{$F+}
Function HeapErrorTrap (Size : Word) : Integer;
Begin
HeapErrorTrap := 1 { New and GetMem return Nil if out_of_memory }
End;
{$F-}
BEGIN
HeapError := @HeapErrorTrap;
END.